home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / util / misc / Fudgit233.lha / Source / src / math.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-12-16  |  7.3 KB  |  404 lines
  1. #include <stdio.h>
  2. #include <math.h>
  3. #include <errno.h>
  4. #if defined (sgi) || defined (sun) || defined (ultrix)
  5. #include <values.h>
  6. #include <nan.h>
  7. #endif
  8. #ifdef AIX
  9. #include <fp.h>
  10. #endif
  11. #ifndef NOSTDLIB_H
  12. #include <stdlib.h>
  13. #endif
  14.  
  15. #include "fudgit.h"
  16. #include "head.h"
  17.  
  18. extern int errno;
  19. #ifndef __HAVE_68881__
  20. extern double cbrt(double), atanh(double), asinh(double), acosh(double);
  21. #ifndef AIX   /* AIX define the following as macros whenever possible */
  22. extern double log(double), log10(double), acos(double);
  23. extern double asin(double), atan(double);
  24. extern double exp(double), sqrt(double);
  25. #endif
  26. #endif
  27. #if defined(NeXT) || defined(OSF)
  28. extern double lgamma(double);
  29. #define gamma(x) lgamma(x)
  30. #else
  31. extern double gamma(double);
  32. #endif
  33. #ifndef __HAVE_68881__
  34. extern double pow(double, double);
  35. extern double cosh(double), sinh(double), tanh(double);
  36. #endif
  37. extern void Ft_matherror (char *s1, char *s2, int lino);
  38. double Ft_errcheck(double x, char *str);
  39.  
  40. double Ft_Rand(void)
  41. {
  42. #ifdef NODRAND48
  43. /* For systems which do not have a better random number generator  */
  44. #include <stdlib.h>
  45.     double x = RAND_MAX;
  46.  
  47.     return((double)rand()/x);
  48. #else
  49.     extern double drand48(void);
  50.     return(drand48());
  51. #endif
  52. }
  53.  
  54. double Ft_Srand(double x)
  55. {
  56.     long xx;
  57. #ifdef NODRAND48
  58. #define srand48(x) srand(x)
  59. #else
  60. extern void srand48(long);
  61. #endif
  62.     xx = (long) x;
  63.     srand48(xx);
  64.     return((double)x);
  65. }
  66.  
  67. double Ft_Log(double x)
  68. {
  69.     errno = 0;
  70.     return(Ft_errcheck(log(x), "ln"));
  71. }
  72.  
  73. double Ft_Log10(double x)
  74. {
  75.     errno = 0;
  76.     return(Ft_errcheck(log10(x), "log"));
  77. }
  78.  
  79. double Ft_Lgamma(double x)
  80. {
  81.     errno = 0;
  82.     return(Ft_errcheck(gamma(x), "lgamma"));
  83. }
  84.  
  85. double Ft_Exp(double x)
  86. {
  87.     errno = 0;
  88.     return(Ft_errcheck(exp(x), "exp"));
  89. }
  90.  
  91. double Ft_Sqrt(double x)
  92. {
  93.     errno = 0;
  94.     return(Ft_errcheck(sqrt(x), "sqrt"));
  95. }
  96.  
  97. double Ft_Pow(double x, double y)
  98. {
  99.     errno = 0;
  100.     return(Ft_errcheck(pow(x, y), "exponentiation"));
  101. }
  102.  
  103. double Ft_Cbrt(double x)
  104. {
  105.     errno = 0;
  106.     return(Ft_errcheck(cbrt(x), "cbrt"));
  107. }
  108.  
  109. double Ft_integer(double x)
  110. {
  111.     return((double)(long)x);
  112. }
  113.  
  114. double Ft_Cosh(double x)
  115. {
  116.     errno = 0;
  117.     return(Ft_errcheck(cosh(x), "cosh"));
  118. }
  119.  
  120. double Ft_Sinh(double x)
  121. {
  122.     errno = 0;
  123.     return(Ft_errcheck(sinh(x), "sinh"));
  124. }
  125.  
  126. double Ft_Tanh(double x)
  127. {
  128.     errno = 0;
  129.     return(Ft_errcheck(tanh(x), "tanh"));
  130. }
  131.  
  132. double Ft_Acosh(double x)
  133. {
  134.     errno = 0;
  135.     return(Ft_errcheck(acosh(x), "acosh"));
  136. }
  137.  
  138. double Ft_Acos(double x)
  139. {
  140.     errno = 0;
  141.     return(Ft_errcheck(acos(x), "acos"));
  142. }
  143.  
  144. double Ft_Asin(double x)
  145. {
  146.     errno = 0;
  147.     return(Ft_errcheck(asin(x), "asin"));
  148. }
  149.  
  150. double Ft_Asinh(double x)
  151. {
  152.     errno = 0;
  153.     return(Ft_errcheck(asinh(x), "asinh"));
  154. }
  155.  
  156. double Ft_Atanh(double x)
  157. {
  158.     errno = 0;
  159.     return(Ft_errcheck(atanh(x), "atanh"));
  160. }
  161.  
  162. double Ft_Coth(double x)
  163. {
  164.     errno = 0;
  165.     return(Ft_errcheck(1.0/tanh(x), "coth"));
  166. }
  167.  
  168. double Ft_Csch(double x)
  169. {
  170.     errno = 0;
  171.     return(Ft_errcheck(1.0/sinh(x), "csch"));
  172. }
  173.  
  174. double Ft_Sech(double x)
  175. {
  176.     errno = 0;
  177.     return(Ft_errcheck(1.0/cosh(x), "sech"));
  178. }
  179.  
  180. double Ft_Cot(double x)
  181. {
  182.     errno = 0;
  183.     return(Ft_errcheck(1.0/tan(x), "cot"));
  184. }
  185.  
  186. double Ft_Hypot(double x, double y)
  187. {
  188.     errno = 0;
  189.     return(Ft_errcheck(hypot(x, y), "hypot"));
  190. }
  191.  
  192. double Ft_Atan2(double x, double y)
  193. {
  194.     errno = 0;
  195.     return(Ft_errcheck(atan2(x, y), "atan2"));
  196. }
  197.  
  198. double Ft_Atan(double x)
  199. {
  200.     errno = 0;
  201.     return(Ft_errcheck(atan(x), "atan"));
  202. }
  203.  
  204. double Ft_Tan(double x)
  205. {
  206.     errno = 0;
  207.     return(Ft_errcheck(tan(x), "tan"));
  208. }
  209.  
  210. double Ft_Csc(double x)
  211. {
  212.     errno = 0;
  213.     return(Ft_errcheck(1.0/sin(x), "csc"));
  214. }
  215.  
  216. double Ft_Sec(double x)
  217. {
  218.     errno = 0;
  219.     return(Ft_errcheck(1.0/cos(x), "sec"));
  220. }
  221.  
  222. double Ft_Y0(double d)
  223. {
  224. #ifdef AMIGA
  225.     Ft_matherror("%s: Function y0() unavailable", NULL, 0);
  226.     errno = EDOM;
  227.     return 0;
  228. #else
  229.     errno = 0;
  230.     return(Ft_errcheck(y0(d), "besy0"));
  231. #endif
  232. }
  233.  
  234. double Ft_Y1(double d)
  235. {
  236. #ifdef AMIGA
  237.     Ft_matherror("%s: Function y1() unavailable", NULL, 0);
  238.     errno = EDOM;
  239.     return 0;
  240. #else
  241.     errno = 0;
  242.     return(Ft_errcheck(y1(d), "besy1"));
  243. #endif
  244. }
  245.  
  246. double Ft_Yn(double i, double d)
  247. {
  248. #ifdef AMIGA
  249.     Ft_matherror("%s: Function yn() unavailable", NULL, 0);
  250.     errno = EDOM;
  251.     return 0;
  252. #else
  253.     errno = 0;
  254.     return(Ft_errcheck(yn((int)i, d), "besyn"));
  255. #endif
  256. }
  257.  
  258. double Ft_Jn(double i, double d)
  259. {
  260. #ifdef AMIGA
  261.     Ft_matherror("%s: Function jn() unavailable", NULL, 0);
  262.     errno = EDOM;
  263.     return 0;
  264. #else
  265.     errno = 0;
  266.     return(Ft_errcheck(jn((int)i, d), "besjn"));
  267. #endif
  268. }
  269.  
  270. double Ft_errcheck(double x, char *str)
  271. {
  272.     extern int Ft_Check;
  273.  
  274.     if (!Ft_Check)
  275.         return(x);
  276.     if (errno == EDOM && Ft_Check & EDOM_CHK) {
  277.         errno = 0;
  278.         Ft_matherror("%s: Argument out of domain.", str, 0);
  279.     }
  280.     else if (errno == ERANGE && Ft_Check & ERANGE_CHK) {
  281.         errno = 0;
  282.         Ft_matherror("%s: Result out of range.", str, 0);
  283.     }
  284. #if defined (IsNaNorINF)
  285.     else if (IsNaNorINF(x) && (Ft_Check & NAN_CHK || Ft_Check & INF_CHK)) {
  286. # if defined (IsINF)
  287.         if (IsINF(x) && Ft_Check & INF_CHK) {
  288.             Ft_matherror("%s: Result infinite.", str, 0);
  289.         }
  290. # endif  /* IsINF */
  291.         Ft_matherror("%s: Result not a number.", str, 0);
  292.     }
  293. #else  /* IsNaNorINF */
  294. # if defined (NaN)
  295.     else if (NaN(x) && Ft_Check & NAN_CHK) {
  296.         Ft_matherror("%s: Result not a number.", str, 0);
  297.     }
  298. # else  /* NaN */
  299. #  if defined (IS_NAN)
  300.     else if (IS_NAN(x) && Ft_Check & NAN_CHK) {
  301.         Ft_matherror("%s: Result not a number.", str, 0);
  302.     }
  303. #  endif  /* IS_NAN */
  304. /* nothing */ /* SUNOS 3.5 does not support #elif */
  305. # endif  /* NaN */
  306. # if defined (IS_INF)
  307.     else if (IS_INF(x) && Ft_Check & INF_CHK) {
  308.         Ft_matherror("%s: Result infinite.", str, 0);
  309.     }
  310. # endif  /* IS_INF */
  311. /* nothing */ /* SUNOS 3.5 does not support #elif */
  312. #endif  /* IsNaNorINF */
  313.     else {
  314.         return(x);
  315.     }
  316.     Ft_matherror("Internal error: Impossible case in Ft_errcheck().", NULL, 0);
  317.     return(ERRR); /* DUMMY */
  318. }
  319.  
  320. double Ft_dbscan(char *s1, char *s2)
  321. {
  322.     double dd;
  323.  
  324.     if (sscanf(s1, s2, &dd) != 1) {
  325.         Ft_matherror("scan: Wrong assignment \"%s\".", s2, 0);
  326.     }
  327.     return(dd);
  328. }
  329.  
  330. double Ft_octal(double x)
  331. {
  332.     long i = (long) rint(x);
  333.     char str[128];
  334.  
  335.     sprintf(str, "%d", i);
  336.     i = strtol(str, (char **)NULL, 8);
  337.     return((double)i);
  338. }
  339.  
  340. double Ft_minimum(double x, double y)
  341. {
  342.     if (x < y)
  343.         return(x);
  344.     return(y);
  345. }
  346.  
  347. double Ft_maximum(double x, double y)
  348. {
  349.     if (x > y)
  350.         return(x);
  351.     return(y);
  352. }
  353.  
  354. #include "symbol.h"
  355.  
  356. double Ft_sum(double *vec)
  357. {
  358.     int i, ndata;
  359.     double val=0.0;
  360.     extern double *Ft_Data;
  361.  
  362.     ndata = (int) *Ft_Data;
  363.     for (i=1; i<=ndata; i++)
  364.         val += vec[i];    
  365.  
  366.     return(val);
  367. }
  368.  
  369. #include <string.h>
  370.  
  371. double Ft_vread(void)
  372. {
  373.     double value;
  374.     int ret = 0;
  375.     extern char Ft_Inname[];
  376.     extern FILE *Ft_Inread;
  377.  
  378.     if (Ft_Inread == stdin) {
  379.         while (ret != 1) {
  380.             fputs("vread? ", stderr);
  381.             ret = fscanf(Ft_Inread, "%lf", &value);
  382.             if (ret < 0)
  383.                 Ft_matherror("vread: stdin EOF encountered.", NULL, 0);
  384.             fprintf(stderr, "vread: Bad entry: Flushing...\n");
  385.             fflush(stdin);
  386.         }
  387.     }
  388.     else {
  389.         ret = fscanf(Ft_Inread, "%lf", &value);
  390.         if (ret < 0) {
  391.             fprintf(stderr,"vread: Reached end of file \"%s\".", Ft_Inname);
  392.             Ft_Inread = stdin;
  393.             strcpy(Ft_Inname, "stdin");
  394.             Ft_matherror("Resetting input to stdin...", NULL, 0);
  395.         }
  396.         else if (ret == 0) {
  397.             Ft_matherror("vread: Could not read value from file \"%s\"\n",
  398.             Ft_Inname, 0);
  399.         }
  400.     }
  401.     return(value);
  402. }
  403.  
  404.